home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / misc / m2pica.lha / M2Picasso / Txt / RBMP.mod < prev    next >
Encoding:
Text File  |  1994-11-17  |  11.1 KB  |  484 lines
  1. (*******************************************************************************
  2.  : Program.         RBMP.MOD
  3.  : Author.          Carsten Wartmann (Crazy Video)
  4.  : Address.         Wutzkyallee 83, 12353 Berlin
  5.  : Phone.           030/6614776
  6.  : E-Mail           C.Wartmann@AMBO.in-berlin.de (bevorzugt)
  7.  : E-Mail           Carsten_Wartmann@tfh-berlin.de
  8.  : Version.         0.5
  9.  : Date.            16.Aug.1994
  10.  : Copyright.       PD
  11.  : Language.        Modula-2
  12.  : Compiler.        M2Amiga V4.3d
  13.  : Contents.        Einlesen / Scaling von BMP (Was mache ich damit ?).
  14. *******************************************************************************)
  15.  
  16. (*$ LargeVars := FALSE*)
  17. (*$StackParms := FALSE*)
  18.  
  19. MODULE RBMP ;
  20.  
  21.  
  22. FROM SYSTEM       IMPORT ADR,ADDRESS,TAG,BITSET,SHIFT,ASSEMBLE ;
  23.  
  24. FROM UtilityD     IMPORT tagEnd,tagDone ;
  25.  
  26. FROM Arts         IMPORT Assert ;
  27.  
  28. FROM ExecL        IMPORT Forbid,Permit,AllocMem,FreeMem,CopyMem ;
  29. FROM ExecD        IMPORT MemReqs,MemReqSet ;
  30.  
  31. FROM DosL         IMPORT Delay ;
  32.  
  33. FROM GraphicsL    IMPORT SetRGB4 ;
  34.  
  35. FROM IntuitionD   IMPORT ScreenPtr ;
  36. FROM IntuitionL   IMPORT ScreenToFront ;
  37.  
  38. FROM RandomNumber IMPORT RND ;
  39.  
  40. FROM VilIntuiSupL IMPORT OpenVillageScreenTagList,CloseVillageScreen,
  41.                          LockVillageScreen,UnLockVillageScreen,
  42.                          VillageRectFill,VillageBlitCopy,WaitVillageBlit,
  43.                          VillageModeRequest,VillageSetDisplayBuf,VillageGetBufAddr ;
  44. FROM VilIntuiSupD IMPORT SetPackedPixel,LinePacked,ClearScreen,ClearBuf,
  45.                          VilFillRecord,VilCopyRecord,VilScrCopy,VilScrAnd,
  46.                          VilDstInvert,VilScrPaint,TavisTags,InvalidID ;
  47.  
  48. FROM FileSystem   IMPORT Lookup,File,Close,ReadChar,done,ReadBytes,SetPos ;
  49.  
  50. FROM InOut        IMPORT WriteInt,WriteLn,WriteString,Write,WriteCard,WriteHex ;
  51.  
  52. FROM String       IMPORT Compare ;
  53.  
  54. FROM Break        IMPORT InstallException ;
  55.  
  56. FROM Timer2       IMPORT StartTime,StopTime,TimeVal ;
  57.  
  58. IMPORT R ;
  59.  
  60.  
  61.  
  62. CONST Bildname = "pics/Galerie160fp.bmp" ;
  63.       Bildw    = 160 ;
  64.       Bildh    = 128 ;
  65.       Cookie   = "pics/Kugeln.bmp" ;
  66.       Cookiew  =  16 ;
  67.       Cookieh  =  240 ;
  68.  
  69.       Faktor   = 1 ;
  70.  
  71.  
  72. VAR cia[0BFE000H]  : BITSET ;
  73.     Joy1[0DFF00CH] : BITSET ;
  74.  
  75.     time      : TimeVal ;
  76.     tags      : ARRAY [0..40] OF LONGCARD ;
  77.     bufadr    : ARRAY [0..1] OF ADDRESS ;
  78.  
  79.     scr       : ScreenPtr ;
  80.     start,
  81.     source,
  82.     cookie    : ADDRESS ;
  83.     col,buf   : LONGINT ;
  84.     mode      : LONGCARD ;
  85.     tc        : SHORTCARD ;
  86.     x,y,ok,
  87.     xmit,ymit,
  88.     xoff,yoff : LONGINT ;
  89.     xc,yc,
  90.     xs,ys     : LONGINT ;
  91.     ct        : LONGINT ;
  92.  
  93.  
  94.  
  95.  
  96.  
  97.  
  98. PROCEDURE Rechts() : BOOLEAN ;
  99.    BEGIN
  100.       RETURN (1 IN Joy1) ;
  101. END Rechts ;
  102.  
  103. PROCEDURE Links() : BOOLEAN ;
  104.    BEGIN
  105.       RETURN (9 IN Joy1) ;
  106. END Links ;
  107.  
  108. PROCEDURE XOR(a,b : BOOLEAN) : BOOLEAN ;
  109.    BEGIN
  110.       RETURN ((a OR b) AND NOT (a AND b)) ;
  111. END XOR ;
  112.  
  113. PROCEDURE Unten() : BOOLEAN ;
  114.    BEGIN
  115.       RETURN XOR(Rechts(),(0 IN Joy1)) ;
  116. END Unten ;
  117.  
  118. PROCEDURE Oben() : BOOLEAN ;
  119.    BEGIN
  120.       RETURN XOR(Links(),(8 IN Joy1)) ;
  121. END Oben ;
  122.  
  123.  
  124. PROCEDURE WaitMaus ;
  125. BEGIN
  126.   WHILE (6 IN cia) DO
  127.   END ;
  128. END WaitMaus ;
  129.  
  130.  
  131. PROCEDURE Erg(elap : TimeVal) ;
  132.   BEGIN
  133.     WriteLn ;
  134.     WriteString("Ergebnis : ") ;
  135.     WriteInt(elap.secs,6) ;
  136.     WriteInt(elap.micro,10) ;
  137.     WriteLn ;
  138.   END Erg ;
  139.  
  140.  
  141. (* Bringt BMP direkt auf den Bildschirm *)
  142. PROCEDURE ReadBMPS(name : ARRAY OF CHAR ; scr : ScreenPtr ; w,h : LONGCARD) ;
  143. VAR f     : File ;
  144.     act,i : LONGINT ;
  145.     start : ADDRESS ;
  146.  
  147.  
  148.   BEGIN
  149.     Lookup(f,name,40000,FALSE) ;
  150.     Assert(f.res=done,ADR("Kann File nicht öffnen !")) ;
  151.     start := LockVillageScreen(scr) ;
  152.  
  153.     SetPos(f,1078) ;
  154.     INC(start,LONGCARD(scr^.width)*(h-1)) ;
  155.     FOR y:=1 TO h DO
  156.       ReadBytes(f,start,w,act) ;
  157.       DEC(start,scr^.width) ;
  158.     END ;
  159.  
  160.     UnLockVillageScreen(scr) ;
  161.     Close(f) ;
  162.   END ReadBMPS ;
  163.  
  164.  
  165. (* Liest BMP in einen Speicherbereich *)
  166. PROCEDURE ReadBMP(name : ARRAY OF CHAR ; w,h : LONGCARD) : ADDRESS ;
  167. VAR f     : File ;
  168.     act,i : LONGINT ;
  169.     start,
  170.     cnt   : ADDRESS ;
  171.  
  172.   BEGIN
  173.     start := AllocMem(w*h,MemReqSet{fast}) ;
  174.     Assert(start#NIL,ADR("Kein Speicher !")) ;
  175.  
  176.     Lookup(f,name,40000,FALSE) ;
  177.     Assert(f.res=done,ADR("Kann File nicht öffnen !")) ;
  178.  
  179. (* Warum stehen BMP-Bilder auf dem Kopf ?
  180.     SetPos(f,1078) ;
  181.     ReadBytes(f,start,w*h,act) ;
  182.     IF (act<LONGINT(w*h)) THEN
  183.       Close(f) ;
  184.       Assert(FALSE,ADR("Fehler beim Bildlesen (w*h?) !")) ;
  185.     END ;
  186. *)
  187.     cnt := start ;
  188.     SetPos(f,1078) ;
  189.     INC(cnt,w*(h-1)) ;
  190.     FOR y:=1 TO h DO
  191.       ReadBytes(f,cnt,w,act) ;
  192.       DEC(cnt,w) ;
  193.     END ;
  194.  
  195.     Close(f) ;
  196.     RETURN(start) ;
  197.  
  198.   END ReadBMP ;
  199.  
  200. (* Extrahiert die Palette eines BMP *)
  201. PROCEDURE ReadPAL(name : ARRAY OF CHAR ; scr : ScreenPtr) ;
  202. VAR f     : File ;
  203.     act,i : LONGINT ;
  204.     r,g,b,
  205.     s     : SHORTCARD ;
  206.  
  207.   BEGIN
  208.     Lookup(f,name,10000,FALSE) ;
  209.     Assert(f.res=done,ADR("Kann File nicht öffnen !")) ;
  210.  
  211.     SetPos(f,54) ;
  212.     FOR col:=0 TO 255 DO
  213.       ReadBytes(f,ADR(b),1,act) ;
  214.       ReadBytes(f,ADR(g),1,act) ;
  215.       ReadBytes(f,ADR(r),1,act) ;
  216.       ReadBytes(f,ADR(s),1,act) ;
  217.       SetRGB4(ADR(scr^.viewPort),col,r,g,b) ;
  218.     END ;
  219.  
  220.     Close(f) ;
  221.   END ReadPAL ;
  222.  
  223.  
  224.  
  225. (* Skaliert auf Screen *)
  226. PROCEDURE ScaleS(scr : ScreenPtr ; xs,ys,w,h,xd,yd,faktor : LONGINT) ;
  227. VAR x,y,
  228.     xx,yy : LONGINT ;
  229.     dst,
  230.     srt   : ADDRESS ;
  231.  
  232.   BEGIN
  233.     start := LockVillageScreen(scr) ;
  234.  
  235.     srt := (LONGINT(start)+xs+ys*LONGINT(scr^.width)) ;
  236.     dst := (LONGINT(start)+xd+yd*LONGINT(scr^.width)) ;
  237.  
  238.     y:=10 ;
  239.     WHILE (y<=h*10) DO
  240.       x:=0 ;
  241.       WHILE (x<w*10) DO
  242.         xx := x DIV 16 ;
  243.         ADDRESS(LONGINT(dst)+x DIV faktor)^ := ADDRESS(LONGINT(srt)+xx)^ ;
  244.         INC(x,faktor) ;
  245.       END ;
  246.       yy := y DIV 10 ;
  247.       srt := ADDRESS(LONGINT(start)+LONGINT(scr^.width)*yy) ;
  248.       INC(dst,scr^.width) ;
  249.       INC(y,faktor) ;
  250.     END ;
  251.     UnLockVillageScreen(scr) ;
  252.  
  253.   END ScaleS ;
  254.  
  255. (*Skaliert Bild aus Speicher auf Screen hoch/runter *)
  256. (*Doch noch xs/ys angeben....*)
  257. PROCEDURE Scale(source : ADDRESS ; scr : ScreenPtr ; w,h,xd,yd,faktor : LONGINT) ;
  258. VAR x,y,
  259.     xx,yy   : LONGINT ;
  260.     dst,srt : ADDRESS ;
  261.  
  262.   BEGIN
  263.     start := LockVillageScreen(scr) ;
  264.  
  265.     dst := (LONGINT(start)+xd+yd*LONGINT(scr^.width)) ;
  266.     srt := source ;
  267.  
  268.     y:=16 ;
  269.     WHILE (y<=SHIFT(h,4)) DO
  270.       x:=0 ;
  271.       WHILE (x<SHIFT(w,4)) DO
  272.         xx := SHIFT(x,-4) ;
  273.         ADDRESS(LONGINT(dst)+x DIV faktor)^ := ADDRESS(LONGINT(srt)+xx)^ ;
  274.         INC(x,faktor) ;
  275.       END ;
  276.       srt := ADDRESS(LONGINT(source)+w*SHIFT(y,-4)) ;
  277.       INC(dst,scr^.width) ;
  278.       INC(y,faktor) ;
  279.     END ;
  280.     UnLockVillageScreen(scr) ;
  281.  
  282.   END Scale ;
  283.  
  284.  
  285. (*Skaliert Bild aus Speicher auf Dest hoch/runter *)
  286. (*Doch noch xs/ys angeben....*)
  287. (*$StackChk := FALSE *)
  288. (*$RangeChk := FALSE *)
  289. (*$OverflowChk := FALSE *)
  290. (*$NilChk := FALSE *)
  291. (*$EntryClear := FALSE *)
  292. (*$CaseChk := FALSE *)
  293. (*$ReturnChk := FALSE *)
  294. PROCEDURE ScaleM(scr : ScreenPtr ; source : ADDRESS ; dest : ADDRESS ;
  295.                  w{R.D2},h,xd,yd,faktor{R.D0} : LONGINT) ;
  296. VAR x{R.D3},
  297.     xs{R.D5},
  298.     sw{R.D1}   : LONGINT ;
  299.     y{R.D4}    : LONGINT ;
  300.     dst{R.A1},
  301.     srt{R.A0}  : ADDRESS ;
  302.  
  303.   BEGIN
  304.     sw := scr^.width ;
  305.     y  := 16 ;
  306.     xs := SHIFT(w,4) ;
  307.     dst := (LONGINT(dest)+xd+yd*sw) ;
  308.     srt := source ;
  309.  
  310.     WaitVillageBlit ;
  311.  
  312.     WHILE (y<=SHIFT(h,4)) DO
  313.       x:=0 ;
  314.       WHILE (x<xs) DO
  315.         ADDRESS(dst+ADDRESS(x DIV faktor))^ := ADDRESS(srt+ADDRESS(SHIFT(x,-4)))^ ;
  316.         INC(x,faktor) ;
  317.       END ;
  318.       srt := source+ADDRESS(w*SHIFT(y,-4)) ;
  319.       INC(dst,sw) ;
  320.       INC(y,faktor) ;
  321.     END ;
  322.  
  323.   END ScaleM ;
  324.  
  325.  
  326. PROCEDURE CookieCut(scr : ScreenPtr ; source : ADDRESS ;
  327.                                         dest : ADDRESS ;
  328.                                         w,h,xd,yd : LONGINT ;
  329.                                         trans : SHORTCARD) ;
  330. VAR x,y,sw   : LONGINT ;
  331.     dst{R.A1},
  332.     srt{R.A0}  : ADDRESS ;
  333.  
  334.   BEGIN
  335.     sw := scr^.width ;
  336.     INC(dest,xd) ;
  337.     INC(dest,sw*yd) ;
  338.     WaitVillageBlit ;
  339.     FOR y:=1 TO h DO
  340.       FOR x:=1 TO w DO
  341.         IF SHORTCARD(source^)#trans THEN
  342.           dest^ := source^ ;
  343.         END ;
  344.         INC(dest,1) ;
  345.         INC(source,1) ;
  346.       END ;
  347.       INC(dest,sw-w) ;
  348.     END ;
  349.  
  350.   END CookieCut ;
  351.  
  352.  
  353.  
  354.  
  355. BEGIN
  356.   InstallException ;
  357.  
  358.   mode := VillageModeRequest(TAG(tags,tavisMinDepth,    8,
  359.                                       tavisMaxDepth,    8,
  360.                                       tavisMinHeight, 256,
  361.                                            tagDone)) ;
  362.   Assert(mode#InvalidID,ADR("Kein Screenmode gewählt !")) ;
  363.  
  364.   scr := OpenVillageScreenTagList(TAG(tags,tavisScreenModeID,  mode,
  365.                                            tavisDoubleBuffer,    2,
  366.                                            tagDone)) ;
  367.   Assert(scr#NIL,ADR("Kann PICASSO Screen nicht öffnen !")) ;
  368.  
  369.   start := LockVillageScreen(scr) ;
  370.   FOR buf:=0 TO 1 DO
  371.     bufadr[buf] := VillageGetBufAddr(scr,buf) ;
  372.   END ;
  373.  
  374.   xmit := scr^.width  DIV 2 ;
  375.   ymit := scr^.height DIV 4 ;   (* wg. DoubleBuffer !!!!!!! *)
  376.   xoff := Bildw * 8 ;
  377.   yoff := Bildh * 8 ;
  378.  
  379.   xc := 100 ;
  380.   yc :=  80 ;
  381.   xs := 3 ;
  382.   ys := 2 ;
  383.  
  384.   UnLockVillageScreen(scr) ;
  385.  
  386.   ReadPAL(Bildname,scr) ;
  387.   source := ReadBMP(Bildname,Bildw,Bildh) ;
  388.   cookie := ReadBMP(Cookie,Cookiew,Cookieh) ;
  389.  
  390.  
  391.   x := 64 ;
  392.   buf := 0 ;
  393.   VillageSetDisplayBuf(scr,buf) ;
  394.  
  395.   WHILE (7 IN cia) DO
  396.    buf := (buf + 1) MOD 2 ;
  397.    ClearBuf(scr,bufadr[buf]) ;
  398.    IF Oben() THEN
  399.      INC(x,Faktor) ;
  400.    ELSIF Unten() THEN
  401.      DEC(x,Faktor) ;
  402.    END ;
  403.  
  404.    xc := xc + xs ;
  405.    IF (xc<=0) OR (xc>=scr^.width-Cookiew) THEN
  406.      xs := xs * (-1) ;
  407.      xc := xc + xs ;
  408.    END ;
  409.    yc := yc + ys ;
  410.    IF (yc<=0) OR (yc>=SHIFT(scr^.height,-1)-16) THEN
  411.      ys := ys * (-1) ;
  412.      yc := yc + ys ;
  413.    END ;
  414.  
  415.    ct := (ct + 1) MOD 15 ;
  416.  
  417.    ScaleM(scr,source,bufadr[buf],Bildw,Bildh,xmit-(xoff DIV x),ymit-(yoff DIV x),x) ;
  418.    CookieCut(scr,cookie+ADDRESS(ct*256),bufadr[buf],Cookiew,16,xc,yc,0) ;
  419.    VillageSetDisplayBuf(scr,buf) ;
  420.   END ;
  421.  
  422. CLOSE
  423.   IF scr#NIL THEN
  424.     UnLockVillageScreen(scr) ;
  425.     CloseVillageScreen(scr) ;
  426.   END ;
  427.   IF source#NIL THEN
  428.     FreeMem(source,Bildw*Bildh) ;
  429.   END ;
  430.   IF cookie#NIL THEN
  431.     FreeMem(cookie,Cookiew*Cookieh) ;
  432.   END ;
  433.  
  434. END RBMP .
  435.  
  436.  
  437. (* Unlocks ändern !!!!!!!!!!!!!!!!!*)
  438.  
  439.  
  440. (*
  441.   Forbid() ;
  442.   StartTime() ;
  443.  
  444.   FOR x :=32 TO 8 BY -1 DO
  445.     buf := (buf + 1) MOD 2 ;
  446.     ClearBuf(scr,bufadr[buf]) ;
  447.     ScaleM(source,bufadr[buf],Bildw,Bildh,xmit-(xoff DIV x),ymit-(yoff DIV x),x) ;
  448.     VillageSetDisplayBuf(scr,buf) ;
  449.   END ;
  450.  
  451.   StopTime(time) ;
  452.   Permit() ;
  453.   WriteString("Alt      : ") ;
  454.   Erg(time) ;
  455. *)
  456. (*
  457.   x := 64 ;
  458.   buf := 0 ;
  459.   VillageSetDisplayBuf(scr,buf) ;
  460.  
  461.   WHILE (7 IN cia) DO
  462.    IF Oben() THEN
  463.      INC(x,Faktor) ;
  464.      buf := (buf + 1) MOD 2 ;
  465.      ClearBuf(scr,bufadr[buf]) ;
  466.      ScaleM(scr,source,bufadr[buf],Bildw,Bildh,xmit-(xoff DIV x),ymit-(yoff DIV x),x) ;
  467.    ELSIF Unten() THEN
  468.      DEC(x,Faktor) ;
  469.      buf := (buf + 1) MOD 2 ;
  470.      ClearBuf(scr,bufadr[buf]) ;
  471.      ScaleM(scr,source,bufadr[buf],Bildw,Bildh,xmit-(xoff DIV x),ymit-(yoff DIV x),x) ;
  472.    END ;
  473.  
  474.    xc := xc + xs ;
  475.    IF (xc<=0) OR (xc>=scr^.width-Cookiew) THEN
  476.      xs := xs * (-1) ;
  477.      xc := xc + xs ;
  478.    END ;
  479.  
  480.    CookieCut(scr,cookie,bufadr[buf],Cookiew,Cookieh,xc,80,0) ;
  481.    VillageSetDisplayBuf(scr,buf) ;
  482.   END ;
  483. *)
  484.